home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / BARNET / COMPILER / SATHER / !Sather / Library / Containrs / sa / array < prev    next >
Text File  |  1996-08-01  |  23KB  |  624 lines
  1. ---------------------------> Sather 1.1 source file <--------------------------
  2. -- Copyright (C) International Computer Science Institute, 1994.  COPYRIGHT  --
  3. -- NOTICE: This code is provided "AS IS" WITHOUT ANY WARRANTY and is subject --
  4. -- to the terms of the SATHER LIBRARY GENERAL PUBLIC LICENSE contained in    --
  5. -- the file "Doc/License" of the Sather distribution.  The license is also   --
  6. -- available from ICSI, 1947 Center St., Suite 600, Berkeley CA 94704, USA.  --
  7. --------> Please email comments to "sather-bugs@icsi.berkeley.edu". <----------
  8.  
  9. -- array.sa: One-dimensional arrays, including sorting, searching, etc.
  10. -- minor modification to the median algorithm
  11. -------------------------------------------------------------------
  12. class ARRAY{T} < $ARR{T} is
  13.    -- One-dimensional arrays of elements of type T, including sorting, 
  14.    -- searching, etc. Array indices start at 0 and go to `asize-1'. 
  15.    -- Most features here work when self is void. The intent is that
  16.    -- a void array behave just like a zero-sized array. Thus self may 
  17.    -- be void on operations which don't try to directly access specific 
  18.    -- elements since any such access would be out of range.
  19.    include COMPARE{T};
  20.    
  21.    private include AREF{T} 
  22.      aget->aget, aset->aset, asize->asize, array_ptr->array_ptr;
  23.    -- Make these public.
  24.    -- Note that self may not be void for these routines
  25.    
  26.    create: SAME is return #SAME(0) end;
  27.    
  28.    create(n:INT):SAME pre n>=0 is 
  29.       -- Create a new array of size `n' all of whose elements are void.
  30.       return new(n) end;
  31.  
  32.    create(a: ARRAY{T}): SAME is
  33.       res ::= #SAME(a.size);
  34.       loop res.set!(a.elt!) end;
  35.       return res;
  36.    end;
  37.  
  38.    create_from(e: $ELT{T}): SAME is
  39.       -- Create an array out of the elements of "e"
  40.       -- Expensive - first converts into an FLIST to determine the
  41.       -- number of elements and then converts the FLIST into an array.
  42.       -- Another possibility would be to iterate twice through the elements
  43.       -- in "e", but iterating through "e" might be an even more expensive
  44.       -- operation. It might also not be possible to iterate through "e"
  45.       -- more than once, depending on the nature of "e"
  46.       fl ::= #FLIST{T};
  47.       loop fl := fl.push(e.elt!) end;
  48.       res ::= #SAME(fl.size);
  49.       loop res.set!(fl.elt!) end;
  50.       return res;
  51.    end;
  52.    
  53.    size:INT is            
  54.       -- The number of elements in the array. Self may be void.
  55.       -- if void(self) then return 0 else return asize end end;
  56.       builtin ARRAY_SIZE; end;
  57.  
  58.    clear is
  59.       -- Set each array element to void. Built-in. Self may be void.
  60.       -- if ~void(self) then aclear end end;
  61.       builtin ARRAY_CLEAR; end;
  62.  
  63.    equals(a: $RO_ARR{T}): BOOL is
  64.       loop if ~elt_eq(elt!,a.elt!) then return false; end; end;
  65.       return true;
  66.    end;
  67.       
  68.    elt!:T is
  69.       -- Yield each element of self in order. Self may be void.
  70.       -- if ~void(self) then loop yield aelt! end end end;
  71.       builtin ARRAY_ELTB; end;
  72.  
  73.    elt!(once beg:INT):T pre ~void(self) and beg.is_bet(0,asize-1) is
  74.       -- Yield each element of self starting at `beg'. Self may 
  75.       -- not be void.
  76.       -- loop yield aelt!(beg) end end;
  77.       builtin ARRAY_ELT_BEGB; end;
  78.    
  79.    elt!(once beg, once num:INT):T
  80.       pre ~void(self)and beg.is_bet(0,size-1) and num.is_bet(0,size-beg) is
  81.       -- Yield `num' successive elements of self starting at
  82.       -- index `beg'. Self may not be void.
  83.       -- loop yield aelt!(beg,num) end end;      
  84.       builtin ARRAY_ELT_BEG_NUMB; end;
  85.    
  86.    elt!(once beg, once num, once step:INT):T
  87.       pre ~void(self) and is_legal_aelts_arg(beg,num,step) is
  88.       -- Yield `num' elements of self starting at `beg' and stepping
  89.       -- by `step' which must not be zero. Self may not be void.
  90.       -- loop yield aelt!(beg,num,step) end end;            
  91.       builtin ARRAY_ELT_BEG_NUM_STEPB; end;
  92.    
  93.    set!(val:T) is
  94.       -- Set successive elements of self to the values of `val'.       
  95.       -- Self may be void.
  96.       -- if ~void(self) then 
  97.       --     loop aset!(val); yield end end end;      
  98.       builtin ARRAY_SETB; end;
  99.  
  100.    set!(once beg:INT,val:T) pre ~void(self) and beg.is_bet(0,size-1) is
  101.       -- Set successive elements starting at `beg' to the values of
  102.       -- `val'. Self may not be void.
  103.       -- loop aset!(beg,val); yield end end;
  104.       builtin ARRAY_SET_BEGB; end;
  105.    
  106.    set!(once beg,once num:INT,val:T) 
  107.       pre ~void(self) and  beg.is_bet(0,size-1) and num.is_bet(0,size-beg) is
  108.       -- Set `num' successive elements of self starting at `beg'
  109.       -- to the values of `val'. Self may not be void.
  110.       -- loop aset!(beg,num,val); yield end end;
  111.       builtin ARRAY_SET_BEG_NUMB; end;
  112.    
  113.    set!(once beg,once num,once step:INT,val:T)
  114.       pre ~void(self) and is_legal_aelts_arg(beg,num,step) is
  115.       -- Set `num' elements of self starting at `beg' stepping 
  116.       -- by `step' to the values of val. `step' must not be zero. 
  117.       -- Self may not be void.
  118.       -- loop aset!(beg,num,step,val); yield end end;
  119.       builtin ARRAY_SET_BEG_NUM_STEPB; end;
  120.  
  121.    resize(n:INT):SAME pre ~void(self) is
  122.       -- Allocate a new array and copy whatever will fit of the
  123.       -- old portion.  Returns the new array.
  124.       res::=#SAME(n);
  125.       loop res.set!(elt!); end;
  126.       return res;
  127.    end;
  128.  
  129.    copy:SAME is
  130.       -- A copy of self.
  131.       if void(self) then return void; end;
  132.       r::=create(size); 
  133.       r.copy(self); 
  134.       return r;
  135.    end;
  136.    
  137.    copy(src:SAME) is
  138.       -- Copy as many elements from `src' to self as will fit.
  139.       -- Both self and `src' may be void.
  140.       -- if ~void(self) and ~void(src) then acopy(src) end end;
  141.       builtin ARRAY_COPY; end;
  142.    
  143.    copy(beg:INT,src:SAME)
  144.       pre ~void(self) and (beg.is_bet(0,size-1) or src.size=0) is
  145.       -- Copy as many elements from `src' to self as will fit when
  146.       -- starting at index `beg' of self. Self may not be void but
  147.       -- `src' may be void.
  148.       -- if ~void(src) then acopy(beg,src) end end;
  149.       builtin ARRAY_COPY_BEG; end;
  150.    
  151.    copy(beg,num:INT, src:SAME) 
  152.       pre ~void(self) and ~void(src) and beg.is_bet(0,size-1) and 
  153.         num.is_bet(0,size-beg) and num<=src.size is
  154.       -- Copy `num' elements from `src' to self starting at index
  155.       -- `beg' of self. Neither self nor `src' may be void.
  156.       -- acopy(beg,num,src) end;
  157.       builtin ARRAY_COPY_BEG_NUM; end;
  158.    
  159.    copy(beg,num,srcbeg:INT,src:SAME) 
  160.       pre ~void(self) and ~void(src) and beg.is_bet(0,size-1) and 
  161.       num.is_bet(0,size-beg) and num<=src.size-srcbeg is   
  162.       -- Copy `num' elements from `src' to self starting at index
  163.       -- `beg' of self and index `srcbeg' of `src'. Meither self nor 
  164.       -- `src' may be void.
  165.       -- acopy(beg,num,srcbeg,src) end;      
  166.       builtin ARRAY_COPY_BEG_NUM_SRCBEG; end;
  167.    
  168.    ind!:INT is
  169.       -- Yield the indices of self in order. Self may be void.
  170.       -- if ~void(self) then loop yield aind! end end end;
  171.       builtin ARRAY_INDB; end;
  172.  
  173.    ind1!:INT is
  174.       -- Yield the indices of self in order. Self may be void.
  175.       -- this is provided for consistency with ARRAY2 and ARRAY3
  176.       -- if ~void(self) then loop yield aind! end end end;
  177.       builtin ARRAY_INDB; end;
  178.    
  179.    subarr(beg,num:INT):SAME 
  180.       pre ~void(self) and beg.is_bet(0,size-1) and
  181.           num.is_bet(0,size-beg) is
  182.       -- A new array with `num' entries copied from self 
  183.       -- starting at `beg'. Self may not be void.
  184.       r::=new(num); r.copy(0,num,beg,self); return r end;
  185.  
  186.    to_reverse is
  187.       -- Reverse the order of the elements in self. Self may be 
  188.       -- void.
  189.       if ~void(self) then
  190.      loop i::=(size/2).times!; 
  191.         u::=size-i-1; t::=[i]; [i]:=[u]; [u]:=t end end end;
  192.    
  193.    reverse:SAME is
  194.       -- A copy of self with the elements in reverse order.
  195.       -- Self may be void.
  196.       if void(self) then return void
  197.       else r::=new(size);
  198.      loop r.set!(asize-1, asize, -1, elt!) end;
  199.      return r end end;
  200.  
  201.    to(src:SAME) pre src.size=size is 
  202.       -- Make self be a copy of `src'. Both may be void.
  203.       loop set!(src.elt!) end end;
  204.  
  205.    to_val(v:T) is
  206.       -- Set each element of self to `v'. Self may be void.
  207.       loop set!(v) end end;      
  208.  
  209.    append(a:SAME):SAME is
  210.       -- A new array consisting of self followed by `a'. Both may be void.
  211.       if void(self) then return a.copy
  212.       elsif void(a) then return copy
  213.       else r::=new(size+a.size); r.copy(self); r.copy(size,a); 
  214.      return r end end;
  215.  
  216.    append(a1,a2:SAME):SAME is
  217.       -- A new array consisting of self followed by `a1' and `a2'. 
  218.       -- More efficient than two appends. Any of the arrays may be void.
  219.       if void(self) then return a1.append(a2)
  220.       elsif void(a1) then return append(a2)
  221.       elsif void(a2) then return append(a1)
  222.       else r::=new(size+a1.size+a2.size); 
  223.      r.copy(self); r.copy(size,a1); r.copy(size+a1.size,a2); 
  224.      return r end end;
  225.  
  226.    append(a1,a2,a3:SAME):SAME is
  227.       -- A new array consisting of self followed by `a1', `a2' 
  228.       -- and `a3'. More efficient than three appends. Any of them may
  229.       -- be void.
  230.       if void(self) then return a1.append(a2,a3)
  231.       elsif void(a1) then return append(a2,a3)
  232.       elsif void(a2) then return append(a1,a3)
  233.       elsif void(a3) then return append(a1,a2)
  234.       else r::=new(size+a1.size+a2.size+a3.size); 
  235.      r.copy(self); r.copy(size,a1); r.copy(size+a1.size,a2);
  236.      r.copy(size+a1.size+a2.size,a3); return r end end;
  237.    
  238.    some(test:ROUT{T}:BOOL):BOOL is
  239.       -- True if some element of self satisfies `test'. 
  240.       -- Self may be void.
  241.       loop if test.call(elt!) then return true end end;
  242.       return false end;
  243.  
  244.    every(test:ROUT{T}:BOOL):BOOL is
  245.       -- True if every element of self satisfies `test'.
  246.       -- Self may be void.
  247.       loop if ~test.call(elt!) then return false end end; 
  248.       return true end;
  249.  
  250.    notany(test:ROUT{T}:BOOL):BOOL is
  251.       -- True if none of the elements of self satisfies `test'.
  252.       -- Self may be void.
  253.       loop if test.call(elt!) then return false end end; 
  254.       return true end;
  255.    
  256.    notevery(test:ROUT{T}:BOOL):BOOL is
  257.       -- True if not every element of self satisfies `test'.
  258.       -- Self may be void.
  259.       loop if ~test.call(elt!) then return true end end;
  260.       return false end;
  261.  
  262.    has(e: T): BOOL is return contains(e) end;
  263.    
  264.    contains(e:T):BOOL is
  265.       -- True if the self has an element which is `elt_eq' to `e'.
  266.       if void(self) then return false end;
  267.       loop if elt_eq(elt!,e) then return true end end;
  268.       return false end;
  269.    
  270.    index_of(e:T):INT is
  271.       -- Return the index of the leftmost element which is `elt_eq' 
  272.       -- to `e' or -1 if there is none. Self may be void.
  273.       loop r::=ind!; if elt_eq(e,[r]) then return r end end; 
  274.       return -1 end;
  275.    
  276.    remove(e:T):SAME is
  277.       -- A new array without the elements which are `elt_eq' to `e'.
  278.       -- Self may be void.
  279.       if void(self) then return void 
  280.       else r::=create(size-count(e));
  281.      loop se::=elt!; if ~elt_eq(se,e) then r.set!(se) end end;
  282.      return r end end;
  283.    
  284.    remove_if(test:ROUT{T}:BOOL):SAME is
  285.       -- A new array without the elements that satisfy `test'.
  286.       -- Self may be void.
  287.       if void(self) then return void 
  288.       else r::=create(size-count_if(test));
  289.      loop e::=elt!; if ~test.call(e) then r.set!(e) end end;
  290.      return r end end;      
  291.    
  292.    remove_duplicates:SAME pre is_sorted is
  293.       -- A new array with only the first copy of duplicated elements.
  294.       -- Self may be void, but must be sorted on input.
  295.       if void(self) or self.size = 1 then
  296.      return self;
  297.       end;
  298.       res  ::= new(size);  -- Same size as self for now...
  299.       ne   ::= 0;          -- Number of elements actually in res;
  300.       prev ::= [0];
  301.       loop curr ::= elt!(1);
  302.      if ~elt_eq(prev,curr) then
  303.         res[ne] := prev;
  304.         ne := ne + 1;
  305.      end;
  306.      prev := curr;
  307.       end;
  308.       -- Bug fix from Arno: Whenever the last n elements were the same, they
  309.       -- were not added to the result.
  310.       res[ne] := [size-1];
  311.       ne := ne+1;
  312.       -- if ~elt_eq([size-2],[size-1]) then res[ne]:=[size-1];ne:=ne + 1;end;
  313.       return res.resize(ne);
  314.    end;
  315.  
  316.    to_replace(o,n:T) is
  317.       -- Replace elements that are `elt_eq' to `o' by `n' where ever it 
  318.       -- occurs. Self may be void.
  319.       loop e::=elt!; 
  320.      if elt_eq(e,o) then e:=n end; 
  321.      set!(e) end end;
  322.  
  323.    to_replace_if(test:ROUT{T}:BOOL, n:T) is
  324.       -- Replace elements that satisfy `test' by `n'.
  325.       -- Self may be void.
  326.       loop e::=elt!; 
  327.      if test.call(e) then e:=n end; 
  328.      set!(e) end end;
  329.  
  330.    find_if(test:ROUT{T}:BOOL):T is
  331.       -- Return leftmost element of self which satisfies `test', 
  332.       -- or void if there is none. Self may be void.
  333.       loop r::=elt!; if test.call(r) then return r end end; 
  334.       return void end;
  335.  
  336.    index_if(test:ROUT{T}:BOOL):INT is
  337.       -- Return the index of the leftmost element that satisfies `test', 
  338.       -- or -1 if there is none. Self may be void.
  339.       loop r::=ind!; if test.call([r]) then return r end end; 
  340.       return -1 end;
  341.  
  342.    count(v:T):INT is
  343.       -- The number of elements that are `elt_eq' to `v'.
  344.       -- Self may be void.
  345.       r::=0; loop if elt_eq(elt!,v) then r:=r+1 end end;
  346.       return r end;
  347.    
  348.    count_if(test:ROUT{T}:BOOL):INT is
  349.       -- The number of elements which satisfy `test'.
  350.       -- Self may be void.
  351.       r::=0; loop if test.call(elt!) then r:=r+1 end end;
  352.       return r end;
  353.  
  354.    mismatch(a:SAME):INT is
  355.       -- The index of the first element of self which differs from 
  356.       -- `a'. -1 if self is a prefix of `a' or self is void.
  357.       if void(self) then return -1 end;
  358.       loop r::=ind!; if ~elt_eq([r],a.elt!) then return r end end;
  359.       return -1 end;
  360.  
  361.    search(a:SAME):INT is
  362.       -- The index of the leftmost subarray of self which matches `a'.
  363.       -- -1 if none or self is void. Uses simple algorithm which has 
  364.       -- good performance unless the arrays are special (eg. many 
  365.       -- repeated values).
  366.       if void(self) then return -1 end;
  367.       loop r::=0.upto!(size-a.size); 
  368.      match::=true;
  369.      loop if ~elt_eq(elt!(r),a.elt!) then match:=false; break! end end;
  370.      if match=true then return r end end; 
  371.       return -1 end;
  372.  
  373.    search(beg:INT,a:SAME):INT pre ~void(self) and beg.is_bet(0,asize-1) is
  374.       -- The index of the leftmost subarray of self starting at `beg' or
  375.       -- beyond, which matches `a'. -1 if none. Uses simple algorithm 
  376.       -- which has good performance unless the arrays are special (eg. 
  377.       -- many repeated values).
  378.       loop r::=beg.upto!(size-a.size); 
  379.      match::=true;
  380.      loop if ~elt_eq(elt!(r),a.elt!) then match:=false; break! end end;
  381.      if match=true then return r end end; 
  382.       return -1 end;
  383.  
  384.    map(r:ROUT{T}:T) is
  385.       -- Set each element of self to the result of applying `r' to it.
  386.       -- Self may be void.
  387.       loop set!(r.call(elt!)) end end;
  388.    
  389.    reduce(r:ROUT{T,T}:T):T is
  390.       -- Combine all the elements of self by applying `r' from 
  391.       -- low indices to high. Void if self is void or size=0.
  392.       if size=0 then return void end; 
  393.       v::=[0]; loop v:=r.call(v,elt!(1,size-1)) end; return v end;
  394.  
  395.    scan(r:ROUT{T,T}:T) is
  396.       -- Set each element in self to the result of applying `r' left to
  397.       -- right to the array up to the element. The first element is left
  398.       -- unchanged. Self may be void.
  399.       if ~void(self) then
  400.      loop i::=1.upto!(size-1); [i]:=r.call([i-1],[i]) end end end; 
  401.    
  402. -- Routines relating to sorted arrays:   
  403.    
  404.    is_sorted:BOOL is 
  405.       -- True if the elements of self are in sorted order according
  406.       -- to `elt_lt'. Self may be void.
  407.       if ~void(self) then
  408.      loop i::=1.upto!(asize-1);
  409.         if elt_lt([i],[i-1]) then return false end end end;
  410.       return true end;
  411.    
  412. -- SOMEBODY TAKE A CLOSE LOOK AT THIS TO SEE IF THERE MIGHT
  413. -- BE A MORE EFFICIENT WAY TO CODE IT.  THE PRECONDITION IS
  414. -- ALSO BROKEN.
  415.    insertion_sort_range(l,u:INT)
  416.       -- pre ~void(self) and l.is_bet(0,asize-1) and u.is_bet(l,asize-1)
  417.       is
  418.       -- Stably sort the elements of self between `l' and `u'
  419.       -- inclusive by insertion sort. `elt_lt' defines the ordering.
  420.       loop
  421.      i::=(l+1).upto!(u); e::=[i];
  422.      loop
  423.         j::=(i - 1).downto!(l-1);
  424.         if (j < l) then [l]:=e; break!;
  425.         elsif (elt_lt([j], e)) then [j+1]:=e; break!;
  426.         else [j+1]:=[j];
  427.         end;
  428.      end;
  429.       end;
  430.    end;
  431.    
  432.    private const quicksort_limit:INT:=10; -- When to stop the
  433.    -- quicksort recursion and switch to insertion sort.
  434.    
  435.    quicksort_range(l,u:INT)
  436.       pre ~void(self) and l.is_bet(0,asize-1) and u.is_bet(l,asize-1) is
  437.       -- Use quicksort to sort the elements of self from `l' to `u'
  438.       -- inclusive according to `elt_lt'.
  439.       if u-l>quicksort_limit then
  440.      r::=RND::int(l,u);
  441.      t::=[r];
  442.      [r]:=[l];
  443.      [l]:=t;
  444.      m::=l;
  445.      loop i::=(l+1).upto!(u); 
  446.         if elt_lt([i],t) then m:=m+1; 
  447.            s::=[m];
  448.            [m]:=[i];
  449.            [i]:=s; 
  450.         end; 
  451.      end;
  452.      t:=[l];
  453.      [l]:=[m];
  454.      [m]:=t;
  455.      if l < m-1 then
  456.         quicksort_range(l,m-1);
  457.      end;
  458.      if m+1 < u then
  459.         quicksort_range(m+1,u);
  460.      end;
  461.       else 
  462.      insertion_sort_range(l,u);
  463.       end;
  464.    end;   
  465.    
  466.    sort post is_sorted is
  467.       -- Use quicksort to permute the elements of self so that 
  468.       -- it is sorted with respect to `elt_lt'. Self may be void.
  469.       if ~void(self) then quicksort_range(0,asize-1) end end;
  470.  
  471.    stable_sort post is_sorted is
  472.       -- Use insertion sort to permute the elements of self so that 
  473.       -- it is sorted with respect to `elt_lt'. Equal elements
  474.       -- retain their initial order. Self may be void.
  475.       if ~void(self) then insertion_sort_range(0,asize-1) end end;   
  476.  
  477.    binary_search(e:T):INT pre is_sorted is
  478.       -- Assuming self is sorted, return the index of the element 
  479.       -- preceding the first element greater than `e' according to
  480.       -- `elt_lt'. -1 if self is void or if all elements are 
  481.       -- greater than `e'. 
  482.       if void(self) then return -1 end;
  483.       l::=0; u::=asize-1;
  484.       if ~elt_lt(e,[u]) then return u end;
  485.       if elt_lt(e,[l]) then return -1 end;
  486.       -- From now on [u] is always known to be greater than `e', and
  487.       -- [l] is not greater than `e'.
  488.       loop while!(u>l+1); j::=(u+l)/2;
  489.      if elt_lt(e,[j]) then u:=j else l:=j end end;
  490.       return l end;
  491.    
  492.    is_sorted_by(lt:ROUT{T,T}:BOOL):BOOL is 
  493.       -- True if the elements of self are in sorted order using
  494.       -- `t' to define "less than". Self may be void.
  495.       if ~void(self) then
  496.      loop i::=1.upto!(asize-1);
  497.         if lt.call([i],[i-1]) then return false end end end;
  498.       return true end;
  499.    
  500.    insertion_sort_by(lt:ROUT{T,T}:BOOL) post is_sorted_by(lt) is
  501.       -- Stably sort the elements of self using `t' to define "less than". 
  502.       -- Self may be void.
  503.       if void(self) then return end;
  504.       loop
  505.      i::=1.upto!(asize-1); e::=[i];
  506.      loop
  507.         j::=(i - 1).downto!(-1);
  508.         if (j < 0) then [0]:=e; break!;
  509.         elsif (lt.call([j], e)) then [j+1]:=e; break!;
  510.         else [j+1]:=[j];
  511.         end;
  512.      end;
  513.       end;
  514.    end;
  515.  
  516.    binary_search_by(e:T, lt:ROUT{T,T}:BOOL):INT pre is_sorted_by(lt) is
  517.       -- Assuming self is sorted by `lt', return the index of the element 
  518.       -- preceding the first element greater than `e'. -1 if self is void 
  519.       -- or if all elements are greater than `e'. 
  520.       if void(self) then return -1 end;
  521.       l::=0; u::=asize-1;
  522.       if ~lt.call(e,[u]) then return u end;
  523.       if lt.call(e,[l]) then return -1 end;
  524.       -- From now on [u] is always known to be greater than `e', and
  525.       -- [l] is not greater than `e'.
  526.       loop while!(u>l+1); 
  527.      j::=(u+l)/2;
  528.      if lt.call(e,[j]) then u:=j else l:=j end end;
  529.       return l end;
  530.    
  531.    merge_with_by(a:SAME, lt:ROUT{T,T}:BOOL):SAME
  532.       pre is_sorted_by(lt) and a.is_sorted_by(lt) 
  533.       post result.is_sorted_by(lt) is   
  534.       -- A new array with the elements of self and `a' merged together
  535.       -- according to `lt' which should return true if its first argument
  536.       -- is less than its second.
  537.       if void(self) then return a.copy end;
  538.       if void(a) then return copy end;      
  539.       r::=create(size+a.size); i,j:INT; w:T;
  540.       loop 
  541.      if i=size then w:=a[j]; j:=j+1
  542.      elsif j=a.size then w:=[i]; i:=i+1
  543.      elsif lt.call([i],a[j]) then w:=[i]; i:=i+1
  544.      else w:=a[j]; j:=j+1 end; 
  545.      r.set!(w) end;
  546.       return r end;
  547.  
  548.    select(i:INT) is
  549.       -- Move the elements of self so that the element with index `i' is 
  550.       -- not `elt_lt' any element with lower indices and no element with
  551.       -- a larger index is `elt_lt' it.
  552.       l::=0; u::=size-1;
  553.       loop until!(l>=u);    -- [0->l-1] <= [l->u] <= [u+1->size-1]
  554.      r::=RND::int(l,u); 
  555.      t::=[r]; [r]:=[l]; [l]:=t; m::=l;     
  556.      loop j::=(l+1).upto!(u);
  557.         if elt_lt([i],t) then m:=m+1; 
  558.            t:=[m]; [m]:=[j]; [j]:=t end end;
  559.      t:=[l]; [l]:=[m]; [m]:=t; -- [l->m-1] <= [m] <= [m+1->u]
  560.      if m<=i then l:=m+1 end;
  561.      if m>=i then u:=m-1 end end end; 
  562.    
  563.    median:T is
  564.       -- The median of the elements contained in self according to the 
  565.       -- ordering relation `elt_lt'. Permutes the elements of self. Void 
  566.       -- if self is void.
  567.       if size=0 then return void end;
  568.       m::=(size-1)/2; select(m); return [m] end;
  569.    
  570.    select_by(lt:ROUT{T,T}:BOOL, i:INT) is
  571.       -- Move the elements of self so that the element with index `i' is 
  572.       -- not `lt' any element with lower indices and no element with
  573.       -- a larger index is `lt' it.
  574.       l::=0; u::=size-1;
  575.       loop until!(l>=u);    -- [0->l-1] <= [l->u] <= [u+1->size-1]
  576.      r::=RND::int(l,u); 
  577.      t::=[r]; [r]:=[l]; [l]:=t; m::=l;     
  578.      loop j::=(l+1).upto!(u);
  579.         if lt.call([j],t) then m:=m+1; 
  580.            t:=[m]; [m]:=[j]; [j]:=t end end;
  581.      t:=[l]; [l]:=[m]; [m]:=t; -- [l->m-1] <= [m] <= [m+1->u]     
  582.      if m<=i then l:=m+1 end;
  583.      if m>=i then u:=m-1 end end end;    
  584.  
  585.    str: STR is
  586.       -- Prints out a string version of the array of the components 
  587.       -- that are under $STR, and their associated indices
  588.       res ::= #FSTR("{");
  589.       i::=0;
  590.       loop until!(i=size);
  591.      e ::= [i];
  592.      if i =  0 then res := res+elt_str(e,i);
  593.      else  res := res + ","+elt_str(e,i); end;
  594.      i := i + 1;
  595.       end;
  596.       res := res +"}";
  597.       return(res.str);
  598.    end;
  599.  
  600.    private elt_str(e: T,i: INT): STR is
  601.       typecase e 
  602.       when $STR then return e.str  else return "Unprintable:"+i.str end;
  603.    end;
  604.  
  605.    inds: ARRAY{INT} is
  606.       -- Return an index array which is the same size as self and
  607.       -- is set to the values of the indices
  608.       sz: INT := size;
  609.       res: ARRAY{INT} := #(sz);
  610.       i: INT := 0;
  611.       loop until!(i >= sz); res[i] := ind!; i := i + 1; end;
  612.       return res;
  613.    end;
  614.    
  615.    has_ind(i: INT): BOOL is
  616.       -- Return true if "i" is a valid index
  617.       return 0<=i and i < size 
  618.    end;
  619.    
  620.    
  621. end; -- class ARRAY{T}   
  622.  
  623.  
  624.